home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / disksctr.pas < prev    next >
Pascal/Delphi Source File  |  1985-09-24  |  7KB  |  168 lines

  1. {     TITLE:  Absolete read program
  2.    PRODUCT:  Turbo Pascal
  3.         OS:  PC-DOS
  4.       DATE:  1/14/85
  5. WRITTEN BY:  Borland International
  6. }
  7.  {----------------------------------------------------------------------------
  8.      This program does an absolute disk read from the drive specified.
  9.   ---------------------------------------------------------------------------}
  10.  
  11. PROGRAM AbsoluteReadInterrupt;
  12.  
  13. TYPE
  14.   DTAtype   = array [0..$FFF] of byte;
  15.   str80     = string[80];
  16.   chararr15 = array [0..15] of char;
  17.  
  18. CONST
  19.   HexStr    : CharArr15 = '0123456789ABCDEF';
  20.  
  21. VAR
  22.   DTA            : DTAtype;                    { Define the DTA             }
  23.   numsect        : byte;                       { Number of sectors to read  }
  24.   flags          : integer absolute CSEG : $00A0; { Address of the flags    }
  25.   LogicalSector  : integer;                    { Sector to read             }
  26.   DriveLetter    : char;                       { Drive to read from         }
  27.   Drive          : byte;                       { Numerical value of drive   }
  28.  
  29. PROCEDURE WhichSector;                         { Get the sector to read     }
  30.  
  31.   VAR
  32.     SectorNumber : 1..8;               { Sector within track                }
  33.     Track        : 0..39;              { Track to read from                 }
  34.     Side         : 0..1;               { Side to read from                  }
  35.  
  36.   BEGIN
  37.     writeln('Side              : ');   { \                                  }
  38.     writeln('Track             : ');   {   Write the prompts                }
  39.     writeln('Sector            : ');   { /                                  }
  40.     writeln('Number of Sectors : ');   {                                    }
  41.     side := -1;
  42.     Repeat
  43.       GotoXY(21,2);                    { Get the side, (0 for side 1)       }
  44.       read(side);
  45.     Until (side in [0,1]);
  46.     Track := -1;
  47.     Repeat
  48.       GotoXY(21,3);                    { Read the track number              }
  49.       read(track);
  50.     Until track in [0..39];
  51.     sectornumber := -1;
  52.     Repeat
  53.       GotoXY(21,4);                    { Read in the relative sector number }
  54.       read(sectornumber);
  55.     Until sectornumber in [1..8];
  56.     numsect := -1;
  57.     Repeat
  58.       GotoXY(21,5);                    { Get the number of setors to read  }
  59.       read(numsect);
  60.     Until (numsect in [0..64]);
  61.                                        { Calculate the logical sector      }
  62.     LogicalSector := (sectorNumber - 1) + (Track * 8) + (side * 320);
  63.   END;
  64.  
  65. PROCEDURE GetSector;                   { This procedure reads the sectors  }
  66.                                        { into the DTA                      }
  67.   TYPE
  68.     regpack = record                   { Define the registers              }
  69.                 ax,bx,cx,dx,bp,di,si,ds,es,flags : integer;
  70.               end;
  71.  
  72.   VAR
  73.     registers : regpack;
  74.  
  75.   BEGIN
  76.     With registers do
  77.       Begin
  78.         ax := drive;                   { Store the drive in AX, ( 0=A,etc. }
  79.         cx := numsect;                 { Number of sectors to read         }
  80.         dx := LogicalSector;           { Which sector to read              }
  81.         ds := seg(DTA);                { direct the sector data to the DTA }
  82.         bx := ofs(DTA);                { segment and offset                }
  83.       End;
  84.     writeln;                           { This is the inline that saves all }
  85.                                        { the volatile registers that INT 25}
  86.                                        { destroys.                         }
  87.     inline( $55             { PUSH   BP        }
  88.            /$50             { PUSH   AX        }
  89.            /$53             { PUSH   BX        }
  90.            /$51             { PUSH   CX        }
  91.            /$52             { PUSH   DX        }
  92.            /$57             { PUSH   DI        }
  93.            /$56             { PUSH   SI        }
  94.            /$06             { PUSH   ES        }
  95.            /$1E);           { PUSH   DS        }
  96.     Intr($25,registers);               { This inline restores all the      }
  97.                                        { registers to their origonal value }
  98.                                        { and stores the flags in CS:00A0   }
  99.     inline( $9F             { LAHF             }
  100.            /$2E             { CS:              }
  101.            /$A3 /$A0 /$00   { MOV   [00A0],AX  }
  102.            /$9D             { POPF             }
  103.            /$1F             { POP   DS         }
  104.            /$07             { POP   ES         }
  105.            /$5E             { POP   SI         }
  106.            /$5F             { POP   DI         }
  107.            /$5A             { POP   DX         }
  108.            /$59             { POP   CX         }
  109.            /$5B             { POP   BX         }
  110.            /$58             { POP   AX         }
  111.            /$5D);           { POP   BP         }
  112.     If (( flags shr 8 ) and 1 ) = 1 then         { If the carry is set then  }
  113.       Case (registers.ax shr 8 ) of               { check for errors          }
  114.         $80: writeln('Attachment failed to respond.');
  115.         $40: writeln('SEEK operation failed.');
  116.         $20: writeln('Controler failure.');
  117.         $10: writeln('Bad CRC on disk read.');
  118.         $08: writeln('DMA overrun on operation.');
  119.         $04: writeln('Requested sector not found.');
  120.         $02: writeln('Address mark not found.');
  121.         $00: writeln('Some nasty undefined error.');
  122.       End;
  123.   End;
  124.  
  125. FUNCTION Hex(number, len : integer):str80;  { This function converts       }
  126.                                             { decimal to hexidecimal       }
  127.   VAR
  128.     buffer : str80;
  129.     nib : byte;
  130.     i : integer;
  131.  
  132.   BEGIN
  133.     buffer := '';
  134.     For i := 0 to len do
  135.       Begin
  136.         nib := (number shr (i * 4)) and $F;
  137.         buffer := buffer + HexStr[ nib ];
  138.       End;
  139.     Hex := buffer;
  140.   END;
  141.  
  142. PROCEDURE DumpDTA;                          { This dumps the DTA           }
  143.  
  144.   VAR
  145.     i : integer;
  146.   BEGIN
  147.     For I := 0 to $FFF do
  148.       BEGIN
  149.       write( chr( DTA[i]));
  150.       END;
  151.   END;
  152.  
  153. BEGIN  { ****  Main Program  **** }
  154.   DriveLetter := 'A';
  155.   numsect := 1;
  156.   write('Which drive? ');
  157.   read(kbd, DriveLetter);
  158.   DriveLetter := UpCase(DriveLetter);
  159.   writeln( DriveLetter );
  160.   If ( DriveLetter in ['A'..'D'] ) then
  161.     Begin
  162.       Drive := ord(DriveLetter) - 65;
  163.       FillChar( DTA, Sizeof( DTA ), 0 );
  164.       WhichSector;                         { Get the sector to read         }
  165.       GetSector;                           { Read in the sector             }
  166.       DumpDTA;                             { Dump the sector to the screen  }
  167.     End;
  168. END.